home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD005b.dsk / CONVERTER.bas < prev    next >
BASIC Source File  |  2003-06-12  |  7KB  |  221 lines
  1. 0  CLEAR 
  2. 10  TEXT 
  3. 20  GOSUB 270: REM ** ERROR HANDLING **
  4. 30  GOTO 1830: REM ** MAIN PROGRAM **
  5. 40  DIM A(8,8)
  6. 50  RESTORE 
  7. 60  FOR I = 1 TO 8
  8. 70  FOR J = 1 TO 8
  9. 80  READ A(I,J)
  10. 90  NEXT J,I
  11. 100  DATA  1,.1,1.0E-3,1.0E-6
  12. 110  DATA  3.937007874E-2,3.28039895E-3,1.093612102E-3,6.213700339E-7
  13. 120  DATA  10,1,1.0E-2,1.0E-5
  14. 130  DATA  3.937007874E-1,3.280839895E-2,1.093612102E-2,6.213700339E-6
  15. 140  DATA  1.0E3,1.0E2,1,1.0E-3
  16. 150  DATA  3.937007874E1,3.280839895,1.093612102,6.213700339E-4
  17. 160  DATA  1.0E6,1.0E5,1.0E3,1
  18. 170  DATA  3.937007874E4,3.280839895E3,1.093612102E3,6.213700339E-1
  19. 180  DATA  2.54E1,2.54,2.54E-2,2.54E-5
  20. 190  DATA   1,  8.333333333E-2,2.777777778E-2,1.578282828E-5
  21. 200  DATA  3.048E2,3.048E1,3.048E-1,3.048E-4
  22. 210  DATA   1.2E1,1,3.333333333E-1,1.893939394E-4
  23. 220  DATA  9.14401E2,9.14401E1,9.14401E-1,9.14401E-4
  24. 230  DATA   3.6E1,3.0,1,5.681818182E-4
  25. 240  DATA  1.609347E6,1.609347E5,1.609347E3,1.609347
  26. 250  DATA  6.3360E4,5.280E3,1.760E3,1
  27. 260  RETURN 
  28. 270  REM  ** ERROR HANDLING ROUTINE **
  29. 280  POKE 768,104: POKE 769,168: POKE 770,104: POKE 771,166: POKE 772,223: POKE 773,154: POKE 774,72: POKE 775,152: POKE 776,72: POKE 777,96
  30. 290  RETURN 
  31. 300  REM  ** UNITS **
  32. 310 U1$ = "MILLIMETERS"
  33. 320 U2$ = "CENTIMETERS"
  34. 330 U3$ = "METERS"
  35. 340 U4$ = "KILOMETERS"
  36. 350 U5$ = "INCHES"
  37. 360 U6$ = "FEET"
  38. 370 U7$ = "YARDS"
  39. 380 U8$ = "MILES"
  40. 390  RETURN 
  41. 400  REM  ** ASSIGN B **
  42. 410  IF B = 1  THEN O$ = U1$
  43. 420  IF B = 2  THEN O$ = U2$
  44. 430  IF B = 3  THEN O$ = U3$
  45. 440  IF B = 4  THEN O$ = U4$
  46. 450  IF B = 5  THEN O$ = U5$
  47. 460  IF B = 6  THEN O$ = U6$
  48. 470  IF B = 7  THEN O$ = U7$
  49. 480  IF B = 8  THEN O$ = U8$
  50. 490  RETURN 
  51. 500  REM  ** ASSIGN Q **
  52. 510  IF Q = 1  THEN D$ = U1$
  53. 520  IF Q = 2  THEN D$ = U2$
  54. 530  IF Q = 3  THEN D$ = U3$
  55. 540  IF Q = 4  THEN D$ = U4$
  56. 550  IF Q = 5  THEN D$ = U5$
  57. 560  IF Q = 6  THEN D$ = U6$
  58. 570  IF Q = 7  THEN D$ = U7$
  59. 580  IF Q = 8  THEN D$ = U8$
  60. 590  RETURN 
  61. 600  REM  ** END PROGRAM **
  62. 610  HOME 
  63. 620 F =  FRE(1): IF F <0  THEN F = 65536 +F
  64. 630  PRINT : PRINT "LENGTH CONVERTER  ";F;" BYTES LEFT": END 
  65. 640  REM  ** SET TABS **
  66. 650 T = 1: REM   TEXT 
  67. 660 P = 18: REM  HOW MANY
  68. 670 M = 9: REM   CATALOG 
  69. 680 V = 16: REM  CONV TAB
  70. 690 K = 14: REM  LOADING DATA
  71. 700  RETURN 
  72. 710  REM  ** CATALOG **
  73. 720  HOME 
  74. 730  HTAB T: VTAB T
  75. 740  PRINT "PICK ANY COMBINATION BY NUMBER "
  76. 750  HTAB T: PRINT 
  77. 760  PRINT "SEPARATE NUMBERS BY A -"
  78. 770  PRINT : PRINT 
  79. 780  PRINT  TAB( M);"1...MILLIMETERS(MM)"
  80. 790  PRINT  TAB( M);"2...CENTIMETERS(CM)"
  81. 800  PRINT  TAB( M);"3...METERS(M)"
  82. 810  PRINT  TAB( M);"4...KILOMETERS(KM)"
  83. 820  PRINT  TAB( M);"5...INCHES(IN.)"
  84. 830  PRINT  TAB( M);"6...FEET(FT.)"
  85. 840  PRINT  TAB( M);"7...YARDS(YDS.)"
  86. 850  PRINT  TAB( M);"8...MILES(MI.)"
  87. 860  PRINT  TAB( M);"9...QUIT"
  88. 870  VTAB V: HTAB T
  89. 880  PRINT "CONVERT FROM WHAT TO WHAT ";
  90. 890  RETURN 
  91. 900  VTAB P: HTAB T: PRINT "HOW MANY ";D$;: RETURN 
  92. 910  REM  ** LOADING DATA **
  93. 920  HOME 
  94. 930  VTAB 10: HTAB K
  95. 940  PRINT " READING DATA"
  96. 950  RETURN 
  97. 960  REM  ** PRINT RESULT **
  98. 970  PRINT 
  99. 980  PRINT H;" ";D$" = ";MO;" ";O$
  100. 990  RETURN 
  101. 1000  REM  ** ADDITIONAL CONVERSIONS **
  102. 1010  PRINT 
  103. 1020  PRINT  TAB( T);"DO YOU WANT ANOTHER"
  104. 1030  PRINT  TAB( T);"CONVERSION WITH THE SAME UNITS (Y/N)? ";: RETURN 
  105. 1040  PRINT C$: RETURN 
  106. 1050  REM  ** ERROR MESSAGE **
  107. 1060  FOR I = 1 TO 500
  108. 1070  VTAB P: FLASH : PRINT "INVALID ENTRY"
  109. 1080  NEXT I
  110. 1090  NORMAL 
  111. 1100  RETURN 
  112. 1110  REM  ** INPUT ROUTINES **
  113. 1120  INPUT " ";C$: RETURN 
  114. 1130  INPUT " ";H$: RETURN 
  115. 1140  GET AN$: RETURN 
  116. 1150  REM  ** INPUT ERROR DETECTION **
  117. 1160  IF B *Q <1  OR B >9  OR Q >9  THEN  GOSUB 1050: GOTO 2000
  118. 1170  IF  LEN(C$) < >3  THEN  GOSUB 1050: GOTO 2000
  119. 1180  IF  ASC( MID$ (C$,2,1)) < >45  THEN  GOSUB 1050: GOTO 2000
  120. 1190  RETURN 
  121. 1200  REM  ** H$ ERROR & FRACTION **
  122. 1210  IF H$ = ""  THEN  GOSUB 1510: GOTO 2080
  123. 1220 P1 = 0
  124. 1230 S = 0
  125. 1240 E = 0
  126. 1250 W =  LEN(H$)
  127. 1260  FOR K = 1 TO W
  128. 1270 FF$ =  MID$ (H$,K,1)
  129. 1280 X =  ASC(FF$)
  130. 1290  IF X = 69  OR X = 43  THEN 1310
  131. 1300  IF X <45  OR X >57  THEN  GOSUB 1510: GOTO 2080
  132. 1310  REM  ** NOS.BETWEEN 45-57**
  133. 1320  REM  ** TEST FOR FALSE BEGININGS **
  134. 1330  IF K = 1  AND X <46  THEN  GOSUB 1510: GOTO 2080
  135. 1340  IF K = 1  AND X >57  THEN  GOSUB 1510: GOTO 2080
  136. 1350  IF K = W  AND X <46  THEN  GOSUB 1510: GOTO 2080
  137. 1360  IF K = W  AND X >57  THEN  GOSUB 1510: GOTO 2080
  138. 1370  IF K = 1  AND X = 47  THEN  GOSUB 1510: GOTO 2080
  139. 1380  IF K = W  AND X = 47  THEN  GOSUB 1510: GOTO 2080
  140. 1390  IF K >1  AND K <W  THEN YM$ =  MID$ (H$,K -1,1):YM =  ASC(YM$)
  141. 1400  IF K >1  AND K <W  AND (X = 45  OR X = 43)  AND YM < >69  THEN  GOSUB 1510: GOTO 2080
  142. 1410  IF X = 47  OR X = 175  THEN S = S +1
  143. 1420  IF X = 69  OR X = 197  THEN E = E +1
  144. 1430  IF X = 46  OR X = 174  THEN P1 = P1 +1
  145. 1440  REM * CHECK FOR TO MANY E S*
  146. 1450  IF P1 >1  THEN  GOSUB 1510: GOTO 2080
  147. 1460  IF E >1  THEN  GOSUB 1510: GOTO 2080
  148. 1470  IF S >1  THEN  GOSUB 1510: GOTO 2080
  149. 1480  NEXT K
  150. 1490  RETURN 
  151. 1500  REM  ** H$ ERROR CORRECTION **
  152. 1510  GOSUB 1050: GOSUB 710: GOSUB 1040
  153. 1520  RETURN 
  154. 1530  REM  ** ERROR CORRECTION **
  155. 1540  CALL 768: GOSUB 1510: GOTO 2080
  156. 1550  REM  ** MANIPULATE C$ **
  157. 1560 Q$ =  LEFT$(C$,2)
  158. 1570 B$ =  RIGHT$(C$,2)
  159. 1580 Q =  VAL(Q$)
  160. 1590 B =  ABS( VAL(B$))
  161. 1600  RETURN 
  162. 1610  REM   ** CHECK FOR FRACTIONS & CALC. H **
  163. 1620 I = 0
  164. 1630 F$ = "/"
  165. 1640 L =  LEN(H$)
  166. 1650 I = I +1
  167. 1660 FF$ =  MID$ (H$,I,1)
  168. 1670  IF FF$ = F$  THEN 1690
  169. 1680  IF I <L  AND FF$ < >F$  THEN 1650
  170. 1690 VF$ =  LEFT$(H$,I -1)
  171. 1700 VF =  VAL(VF$)
  172. 1710 LF$ =  RIGHT$(H$,L -I)
  173. 1720 LF =  VAL(LF$)
  174. 1730  IF LF = 0  THEN  GOSUB 1510: GOTO 2080
  175. 1740 H = VF/LF
  176. 1750  RETURN 
  177. 1760  REM  ** H$ VALUE NO FRACTION **
  178. 1770 H =  VAL(H$)
  179. 1780  RETURN 
  180. 1790  REM  ** CALCULATION FOR H & MO **
  181. 1800 MO = H *(A(Q,B))
  182. 1810  RETURN 
  183. 1820  REM   ***********************
  184. 1830  REM  ** LENGTH CONVERSIONS **
  185. 1840  REM  ** ENGLISH TO METRIC  **
  186. 1850  REM  ** METRIC TO ENGLISH  **
  187. 1860  REM  ** METRIC TO METRIC   **
  188. 1870  REM  ** ENGLISH TO ENGLISH **
  189. 1880  REM  ** FRACTIONS ALLOWED  **
  190. 1890  REM   *****************************
  191. 1900  REM  ** BY A.STEPHEN GALLAGHER   **
  192. 1910  REM  ** GOETHESTRASSE 25         **
  193. 1920  REM  ** D 5200 SIEGBURG          **
  194. 1930  REM  ** WEST GERMANY             **
  195. 1940  REM  ** (02241)50484             **
  196. 1950  REM  ** 28 AUGUST 1979           **
  197. 1960  REM  ******************************
  198. 1970  GOSUB 640: REM  SET TABS
  199. 1980  GOSUB 910: REM  PRINT LOADING
  200. 1990  GOSUB 40: REM  LOADING DATA
  201. 2000  GOSUB 710: REM  CATALOG
  202. 2010  GOSUB 1120: REM  INPUT WHAT
  203. 2020  GOSUB 1550: REM  FIND B,Q
  204. 2030  GOSUB 300: REM  DEFINE U$
  205. 2040  GOSUB 500: REM  ASSIGN Q
  206. 2050  GOSUB 400: REM  ASSIGN B
  207. 2060  IF Q = 9  OR B = 9  THEN  GOTO 600: REM  END
  208. 2070  GOSUB 1150: REM  TEST INPUT
  209. 2080  GOSUB 900: REM  HOW MANY
  210. 2090  GOSUB 1130: REM  INPUT
  211. 2100  ONERR  GOTO 1530
  212. 2110  GOSUB 1200: REM   TEST INPUT
  213. 2120  IF S = 1  THEN  GOSUB 1610: GOTO 2140
  214. 2130  GOSUB 1760: REM  VALUE H$
  215. 2140  GOSUB 1790: REM  CALC. H & MO
  216. 2150  GOSUB 960: REM  PRINT RESULT
  217. 2160  GOSUB 1000: REM  ANOTHER?
  218. 2170  GOSUB 1140: REM  GET Y/N
  219. 2180  IF AN$ = "N"  THEN 2000
  220. 2190  IF AN$ = "Y"  THEN  GOSUB 710: GOSUB 1040: GOTO 2080
  221. 2200  GOTO 2170